home *** CD-ROM | disk | FTP | other *** search
/ SuperHack / SuperHack CD.bin / CODING / MISC / MAG10.ZIP / SPRITES.PAS < prev    next >
Encoding:
Pascal/Delphi Source File  |  1997-02-26  |  5.6 KB  |  239 lines
  1. Unit Sprites;
  2.  
  3. { Version 1.1 }
  4.  
  5. Interface
  6.  
  7. Type Sprite=Record
  8.                   Img:Pointer;
  9.                   Back:Pointer;
  10.                   X,Y:Integer;
  11.             End;
  12.  
  13. Var MinX,MaxX:Integer;
  14.     MinY,MaxY:Integer;
  15.  
  16. Procedure GetImage(x1,y1,x2,y2:Word;Var Img:Pointer;Where:Word);
  17. Procedure KillImage(Var Img:Pointer);
  18. Procedure PutImage(X,Y:Word;Var Img:Pointer;Where:Word);
  19. Procedure PutImage_C(X,Y:Integer;Var Img:Pointer;Where:Word);
  20. Procedure PutImage_T(X,Y:Word;Var Img:Pointer;Where:Word);
  21. Procedure PutImage_CT(X,Y:Integer;Var Img:Pointer;Where:Word);
  22. Procedure SaveImage(Var F:File;Img:Pointer);
  23. Procedure LoadImage(Var F:File;Var Img:Pointer);
  24. Procedure FlipHoriz(Var Img:Pointer);
  25. Procedure FlipVert(Var Img:Pointer);
  26.  
  27. Implementation
  28.  
  29. Uses Mode13h;
  30.  
  31. Procedure GetImage(x1,y1,x2,y2:Word;Var Img:Pointer;Where:Word);
  32. Var Dx,Dy:Word;
  33.     A,B:Word;
  34.     Segm,Offs:Word;
  35. Begin
  36.      Dx:=Abs(x2-x1)+1;
  37.      Dy:=Abs(y2-y1)+1;
  38.      GetMem(Img,Dx*Dy+4);
  39.      Segm:=Seg(Img^);
  40.      Offs:=Ofs(Img^);
  41.      Move(Dx,Mem[Segm:Offs],2);
  42.      Move(Dy,Mem[Segm:Offs+2],2);
  43.      Offs:=Offs+4;
  44.      For A:=y1 to y2 Do
  45.      For B:=x1 to x2 Do
  46.      Begin
  47.           Mem[Segm:Offs]:=GetPixel(B,A,Where);
  48.           Inc(Offs);
  49.      End;
  50. End;
  51.  
  52. Procedure KillImage(Var Img:Pointer);
  53. Var Dx,Dy:Word;
  54.     Segm,Offs:Word;
  55. Begin
  56.      Segm:=Seg(Img^);
  57.      Offs:=Ofs(Img^);
  58.      Move(Mem[Segm:Offs],Dx,2);
  59.      Move(Mem[Segm:Offs+2],Dy,2);
  60.      FreeMem(Img,Dx*Dy+4);
  61. End;
  62.  
  63. Procedure PutImage(X,Y:Word;Var Img:Pointer;Where:Word);
  64. Var Dx,Dy:Word;
  65.     A,B:Word;
  66.     Segm,Offs:Word;
  67. Begin
  68.      Segm:=Seg(Img^);
  69.      Offs:=Ofs(Img^);
  70.      Move(Mem[Segm:Offs],Dx,2);
  71.      Move(Mem[Segm:Offs+2],Dy,2);
  72.      Offs:=Offs+4;
  73.      For A:=Y To Y+Dy-1 Do
  74.      Begin
  75.           Move(Mem[Segm:Offs],Mem[Where:A*320+X],Dx);
  76.           Offs:=Offs+Dx;
  77.      End;
  78. End;
  79.  
  80. Procedure PutImage_C(X,Y:Integer;Var Img:Pointer;Where:Word);
  81. Var Dx,Dy:Word;
  82.     A,B:Word;
  83.     Segm,Offs:Word;
  84. Begin
  85.      Segm:=Seg(Img^);
  86.      Offs:=Ofs(Img^);
  87.      Move(Mem[Segm:Offs],Dx,2);
  88.      Move(Mem[Segm:Offs+2],Dy,2);
  89.      Offs:=Offs+4;
  90.      A:=Y;
  91.      While (A<=Y+DY-1) And (A<MaxY) Do
  92.      Begin
  93.           B:=X;
  94.           While (B<=X+DX-1) And (B<MaxX) Do
  95.           Begin
  96.                If (X>=MinX) And (Y>=MinY) Then
  97.                  PutPixel(B,A,Mem[Segm:Offs],Where);
  98.                Inc(Offs);
  99.                Inc(B);
  100.           End;
  101.           Inc(A);
  102.      End;
  103. End;
  104.  
  105. Procedure PutImage_T(X,Y:Word;Var Img:Pointer;Where:Word);
  106. Var Dx,Dy:Word;
  107.     A,B:Word;
  108.     Segm,Offs:Word;
  109. Begin
  110.      Segm:=Seg(Img^);
  111.      Offs:=Ofs(Img^);
  112.      Move(Mem[Segm:Offs],Dx,2);
  113.      Move(Mem[Segm:Offs+2],Dy,2);
  114.      Offs:=Offs+4;
  115.      For A:=Y To Y+Dy-1 Do
  116.      Begin
  117.           For B:=X To X+Dx-1 Do
  118.           Begin
  119.                If Mem[Segm:Offs]<>0 Then PutPixel(B,A,Mem[Segm:Offs],Where);
  120.                Inc(Offs);
  121.           End;
  122.      End;
  123. End;
  124.  
  125. Procedure PutImage_CT(X,Y:Integer;Var Img:Pointer;Where:Word);
  126. Var Dx,Dy:Word;
  127.     A,B:Word;
  128.     Segm,Offs:Word;
  129. Begin
  130.      Segm:=Seg(Img^);
  131.      Offs:=Ofs(Img^);
  132.      Move(Mem[Segm:Offs],Dx,2);
  133.      Move(Mem[Segm:Offs+2],Dy,2);
  134.      Offs:=Offs+4;
  135.      A:=Y;
  136.      While (A<=Y+DY-1) And (A<MaxY) Do
  137.      Begin
  138.           B:=X;
  139.           While (B<=X+DX-1) And (B<MaxX) Do
  140.           Begin
  141.                If (X>=MinX) And (Y>=MinY) And (Mem[Segm:Offs]<>0) Then
  142.                  PutPixel(B,A,Mem[Segm:Offs],Where);
  143.                Inc(Offs);
  144.                Inc(B);
  145.           End;
  146.           Inc(A);
  147.      End;
  148. End;
  149.  
  150. Procedure SaveImage(Var F:File;Img:Pointer);
  151. Var Dx,Dy:Word;
  152.     Segm,Offs:Word;
  153. Begin
  154.      Segm:=Seg(Img^);
  155.      Offs:=Ofs(Img^);
  156.      Move(Mem[Segm:Offs],Dx,2);
  157.      Move(Mem[Segm:Offs+2],Dy,2);
  158.      BlockWrite(F,Img^,Dx*Dy+4);
  159. End;
  160.  
  161. Procedure LoadImage(Var F:File;Var Img:Pointer);
  162. Var Dx,Dy:Word;
  163.     Segm,Offs:Word;
  164. Begin
  165.      BlockRead(F,Dx,2);
  166.      BlockRead(F,Dy,2);
  167.      GetMem(Img,Dx*Dy+4);
  168.      Segm:=Seg(Img^);
  169.      Offs:=Ofs(Img^);
  170.      Move(Dx,Mem[Segm:Offs],2);
  171.      Move(Dy,Mem[Segm:Offs+2],2);
  172.      Offs:=Offs+4;
  173.      BlockRead(F,Mem[Segm:Offs],Dx*Dy);
  174. End;
  175.  
  176. Procedure FlipHoriz(Var Img:Pointer);
  177. Var Dx,Dy:Word;
  178.     S1,O1:Word;
  179.     S2,O2:Word;
  180.     Tmp:Pointer;
  181.     A,B:Word;
  182. Begin
  183.      { Get X and Y sizes }
  184.      S1:=Seg(Img^);
  185.      O1:=Ofs(Img^);
  186.      Move(Mem[S1:O1],Dx,2);
  187.      Move(Mem[S1:O1+2],Dy,2);
  188.      { Create temporary sprite }
  189.      GetMem(Tmp,Dx*Dy+4);
  190.      S2:=Seg(Tmp^);
  191.      O2:=Ofs(Tmp^);
  192.      { Put the size of the sprite in the temporary sprite }
  193.      Move(Mem[S1:O1],Mem[S2:O2],4);
  194.      { Move the columns }
  195.      For A:=0 To Dx-1 Do
  196.        For B:=0 To Dy-1 Do
  197.          Move(Mem[S1:O1+(B*Dx+A+4)],
  198.               Mem[S2:O2+(B*Dx+(Dx-A-1)+4)],1);
  199.      { Kill old image }
  200.      KillImage(Img);
  201.      { Copy new image to old one }
  202.      Img:=Tmp;
  203. End;
  204.  
  205. Procedure FlipVert(Var Img:Pointer);
  206. Var Dx,Dy:Word;
  207.     S1,O1:Word;
  208.     S2,O2:Word;
  209.     Tmp:Pointer;
  210.     A:Word;
  211. Begin
  212.      { Get X and Y sizes }
  213.      S1:=Seg(Img^);
  214.      O1:=Ofs(Img^);
  215.      Move(Mem[S1:O1],Dx,2);
  216.      Move(Mem[S1:O1+2],Dy,2);
  217.      { Create temporary sprite }
  218.      GetMem(Tmp,Dx*Dy+4);
  219.      S2:=Seg(Tmp^);
  220.      O2:=Ofs(Tmp^);
  221.      { Put the size of the sprite in the temporary sprite }
  222.      Move(Mem[S1:O1],Mem[S2:O2],4);
  223.      { Move the lines }
  224.      For A:=0 To Dy-1 Do
  225.        Move(Mem[S1:O1+(A*Dx+4)],
  226.             Mem[S2:O2+((Dy-1-A)*Dx+4)],Dx);
  227.      { Kill old image }
  228.      KillImage(Img);
  229.      { Copy new image to old one }
  230.      Img:=Tmp;
  231. End;
  232.  
  233. Begin
  234.      MinX:=0;
  235.      MaxX:=319;
  236.      MinY:=0;
  237.      MaxY:=199;
  238. End.
  239.